1 Imports System.Data.OleDb
2 Imports System.Text
3 Imports System.Security.Cryptography
4
5 Public Class frmLogin
6 Dim uname As String
7 Dim passwd As String
8 Dim attempts As Integer = 5
9 Dim connstring As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=|datadirectory|\hrs.mdb"
10 Dim connect As New OleDbConnection
11
12 #Region "Connections"
13 Public Sub openconnection()
14 If connect.State = ConnectionState.Closed Then
15 connect.ConnectionString = connstring
16 connect.Open()
17 ElseIf connect.State = ConnectionState.Open Then
18 Me.Refresh()
19 End If
20 End Sub
21
22 Public Sub closeconnection()
23 If connect.State = ConnectionState.Open Then
24 connect.Close()
25 ElseIf connect.State = ConnectionState.Closed Then
26 Me.Refresh()
27 End If
28 End Sub
29 #End Region
30
31 #Region "Login Button"
32 Private Sub OK_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OK.Click
33 openconnection()
34 uname = UsernameTextBox.Text.Trim
35 passwd = PasswordTextBox.Text.Trim
36
37 If attempts = 0 Then
38 MsgBox("For security purpose, HRS will now close", MsgBoxStyle.Information, "Security level 2")
39 closeconnection()
40 Me.Dispose()
41 Me.Close()
42 ElseIf uname = "" Or IsNothing(uname) = True Then
43 hideerrors()
44 lblErroruname.Show()
45 lblErroruname.Text = "Please enter username"
46 UsernameTextBox.Focus()
47 attempts = attempts - 1
48 lblErrorattempts.Text = attempts & " Attempts left"
49 Exit Sub
50 ElseIf uname.Length < 4 Then
51 hideerrors()
52 lblErroruname.Show()
53 lblErroruname.Text = "Please enter username correctly"
54 UsernameTextBox.Focus()
55 attempts = attempts - 1
56 lblErrorattempts.Text = attempts & " Attempts left"
57 Exit Sub
58
59 ElseIf passwd = "" Or IsNothing(passwd) = True Then
60 hideerrors()
61 lblErrorpassword.Show()
62 lblErrorpassword.Text = "Please enter password"
63 PasswordTextBox.Focus()
64 attempts = attempts - 1
65 lblErrorattempts.Text = attempts & " Attempts left"
66 Exit Sub
67 ElseIf passwd.Length < 6 Then
68 hideerrors()
69 lblErrorpassword.Show()
70 lblErrorpassword.Text = "Please enter password correctly"
71 PasswordTextBox.Focus()
72 attempts = attempts - 1
73 lblErrorattempts.Text = attempts & " Attempts left"
74 Exit Sub
75
76 Else
77 Dim Ue As New UnicodeEncoding()
78 Dim ByteSourceText() As Byte = Ue.GetBytes(passwd)
79 Dim Md5 As New MD5CryptoServiceProvider()
80 Dim ByteHash() As Byte = Md5.ComputeHash(ByteSourceText)
81 Convert.ToBase64String(ByteHash)
82 Dim hashPwd As String
83 hashPwd = Convert.ToBase64String(ByteHash)
84
85 Dim selectqry As String = "SELECT uname,passwd FROM users WHERE uname='" + uname + "'"
86 Dim da As OleDbDataAdapter
87 da = New OleDbDataAdapter(selectqry, connect)
88 Dim dtset As DataSet
89 dtset = New DataSet()
90 Try
91 da.Fill(dtset, "users")
92 Catch ex As Exception
93 MsgBox("Error occured. Please try again", MessageBoxIcon.Error, "Error")
94 Exit Sub
95 End Try
96 Dim dttable As DataTable
97 dttable = New DataTable
98 dttable = dtset.Tables("users")
99
100 Dim dbuname, dbpasswd As String
101 For Each tempRow In dttable.Rows
102 dbuname = tempRow("uname").ToString
103 dbpasswd = tempRow("passwd").ToString
104
105 If (dbuname = uname) And (dbpasswd = hashPwd) Then
106 clearinputs()
107 closeconnection()
108 MsgBox("Welcome " + uname, MsgBoxStyle.Information, "Welcome")
109 frmMain.Show()
110 attempts = 5
111 hideerrors()
112 Me.Hide()
113
114 Else
115 attempts = attempts - 1
116 hideerrors()
117 MsgBox("Error occured. Please try again", MessageBoxIcon.Warning, "Error")
118 lblErrorattempts.Show()
119 lblErrorattempts.Text = attempts & " Attempts left"
120 Me.Refresh()
121 Me.WindowState = FormWindowState.Normal
122 Exit Sub
123 End If
124 Next
125
126 End If
127 End Sub
128 #End Region
129
130 #Region "Cancel Button"
131 Private Sub Cancel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Cancel.Click
132 Me.Dispose()
133 Me.Close()
134 End Sub
135 #End Region
136
137 #Region "Clear inputs"
138 Private Sub clearinputs()
139 UsernameTextBox.Clear()
140 PasswordTextBox.Clear()
141 End Sub
142 #End Region
143
144 #Region "Hide errors"
145 Private Sub hideerrors()
146 lblErrorattempts.Hide()
147 lblErroruname.Hide()
148 lblErrorpassword.Hide()
149 End Sub
150 #End Region
151 End Class
